home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / JANUS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  45KB  |  1,435 lines
  1. UNIT Janus;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Janus transfer protocol                       Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32;
  16.  
  17. PROCEDURE DoJanus;
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES Dos, OpCrt, OpRoot, OpDate, OpString, OpDos, ApTimer,
  22.      PoPTypes, Globals, StrUtil, FileUtil, MailUtil, Com, ZMisc, UnixDate,
  23.      Crc, Util, MTask, ParseReq, PTpl, TransVid, LogFile, NetFile, SimpDB,
  24.      Event, OproUtil;
  25.  
  26. PROCEDURE DoJanus;
  27. LABEL
  28.   GiveUp, abort, BreakOut;
  29. CONST
  30.   DLE            = $10;
  31.   BUFMAX         = 2048;
  32.   NUMFLAGS       = 5;
  33.   XDONE          = 0;
  34.   XSENDFNAME     = 1;
  35.   XRCVFNACK      = 2;
  36.   XSENDBLK       = 3;
  37.   XRCVEOFACK     = 4;
  38.   XSENDFREQNAK   = 5;
  39.   XRCVFRNAKACK   = 6;
  40.  
  41.   RDONE = 0;
  42.   RRCVFNAME = 1;
  43.   RRCVBLK = 2;
  44.  
  45.   NOPKT       = 0;
  46.   BADPKT      = Byte('@');
  47.   FNAMEPKT    = Byte('A');
  48.   FNACKPKT    = Byte('B');
  49.   BLKPKT      = Byte('C');
  50.   RPOSPKT     = Byte('D');
  51.   EOFACKPKT   = Byte('E');
  52.   HALTPKT     = Byte('F');
  53.   HALTACKPKT  = Byte('G');
  54.   FREQPKT     = Byte('H');      { File Request Packet }
  55.   FREQNAKPKT  = Byte('I');
  56.   FRNAKACKPKT = Byte('J');
  57.  
  58.   BUFEMPTY  = -1;
  59.   PKTSTRT   = -2;
  60.   PKTEND    = -3;
  61.   NOCARRIER = -4;
  62.   PKTSTRT32 = -5;
  63.  
  64.   PKTSTRTCHR   = Byte('a');
  65.   PKTENDCHR    = Byte('b');
  66.   PKTSTRTCHR32 = Byte('c');
  67.  
  68.   GOODXFER    = 0;
  69.   FAILEDXFER  = 1;
  70.   INITIALXFER = 2;
  71.   ABORTXFER   = 3;
  72.   SENDRSPFILE = 4;
  73.  
  74.   CANCRC32 = $80;
  75.   CANFREQ  = $40;
  76.  
  77. TYPE
  78.   BufferType = ARRAY[0..5000] Of Byte;
  79.  
  80. VAR
  81.   OURCAP, BadXFers, LastSent : Byte;
  82.   RxCRC32       : BOOLEAN;
  83.   p, rcrc16     : WORD;
  84.   rcrc32        : LongInt;
  85.   OutboundName : PathStr;
  86.   FloFlag      : Boolean;
  87.   FloNamePos   : LongInt;
  88.  
  89.   fn, s                                           : PathStr;
  90.   AttemptingReq,ReqStarted, SendingReq,
  91.   TxInhibit, MustWriteDRI                         : Boolean;
  92.   i, PktType                                      : Integer;
  93.   SAddress, OAddress, ReqAddress                  : TFidoAddress;
  94.   RxBufMax, RxBlkLen, BlkLen, TxBlkLen, TxBlkMax,
  95.   GoodNeeded, GoodBytes, RPosCount, Days          : Word;
  96.   XMitRetry, BrainDead, RPosRetry                 : EventTimer;
  97.   Secs, TxPos, LastTx, TxStPos,
  98.   RxStPos, TxLen,
  99.   TotalBytes, DiskAvail, RxLen, RxFileTime,
  100.   TimeOutSecs, RposStTime, LastRPosTime,
  101.   LastBlkPos                                      : LongInt;
  102.   ReqFile                                         : PBufTextFile;
  103.   Effektivitet                                    : Real;
  104.   BusyFile, FloFile, TxFile, RxFile               : File;
  105.   TxBuf, RxBuf                                    : Pointer;
  106.   ReqAkaNum, RState, XState, WaitFlag, AkaNum,
  107.   SharedCap                                       : Byte;
  108.   RxDt1, TxDt1, StartTime                         : DateTimeRec;
  109.   TxFName, RxFName                                : String;
  110.   DoAfter                                         : Char;
  111.   FreeArea : TFreeArea;
  112.  
  113.   PROCEDURE Time(VAR t:LONGINT);
  114.   VAR
  115.     y,m,d,dofw,hour,min,sec,sec100:WORD;
  116.   BEGIN
  117. {$IFDEF JDebug}
  118.     FastWrite('Time ',1,1,7);
  119. {$ENDIF}
  120.     GetDate(y,m,d,dofw);
  121.     GetTime(hour,min,sec,sec100);
  122.     t:=GetUnixDate(y,m,d,hour,min,sec);
  123. {$IFDEF JDebug}
  124.     FastWrite('END Time ',1,1,7);
  125. {$ENDIF}
  126.   END;
  127.  
  128.   PROCEDURE GetFName(XFerFlag: WORD);
  129.   LABEL
  130.     DoItAgain,SkipName, Abort, NxtOut, RdFLO, SendIt, SendIt2, NextAka;
  131.   VAR
  132.     dt           : DateTime;
  133.     s, HoldName  : PathStr;
  134.     CurrPos      : LongInt;
  135.     i            : Byte;
  136.     f            : SEARCHREC;
  137.     Ch           : Char;
  138.   BEGIN
  139. {$IFDEF JDebug}
  140.     FastWrite('GetFName ',1,1,7);
  141. {$ENDIF}
  142. DoItAgain:
  143.     IF XFerFlag=InitialXFer THEN
  144.     BEGIN
  145.       FLOFlag:=FALSE;
  146.       OutboundName:='';
  147.       DoAfter:=NothingAfter;
  148.       BadXFers:=0;
  149.       FloNamePos:=0;
  150.       IF NOT MarkNodeBusy(BusyFile, Call) THEN
  151.       BEGIN
  152.         AddLog(':',Address2Str(Call)+' is marked busy - skipping');
  153.         GOTO NextAka;
  154.       END;
  155.     END ELSE
  156.     BEGIN
  157.       IF (CurrentEvent.typ AND etNoSend)=etNoSend THEN
  158.       BEGIN
  159.         Integer(TxBuf^):=0;
  160.         UnMarkNodeBusy(BusyFile);
  161.         Exit;
  162.       END;
  163.       IF FileRec(TxFile).Mode<>fmclosed THEN
  164.       BEGIN
  165.         CLOSE(TxFile);
  166.         IF XFerFlag=GoodXFer THEN
  167.         BEGIN
  168.           CASE DoAfter OF
  169.             DeleteAfter,
  170.             ShowDeleteAfter : BEGIN
  171.                                   IF DoAfter=ShowDeleteAfter THEN
  172.                                     AddLog('!','Unlinking '+TxFName);
  173.                                   DeleteFile(TxFName);
  174.                                 END;
  175.             TruncAfter       : BEGIN
  176.                                   AddLog('!','Flagging '+TxFName+' as sent');
  177.                                   TruncateFile(TxFName);
  178.                                 END;
  179.           END;
  180. SkipName:
  181.           IF FLOFlag THEN
  182.           BEGIN
  183.             IF (DoAfter<>NothingAfterRefuse) THEN
  184.             BEGIN
  185.               CurrPos:=FilePos(FLOFile);
  186.               i:=Byte('~');
  187.               SEEK(FLOFile,FLONamePos);
  188.               BlockWRITE(FLOFile,i,1);
  189.               SEEK(FLOFile,CurrPos);
  190.             END;
  191.             GOTO RdFlo;
  192.           END;
  193.         END ELSE
  194.         BEGIN
  195. Abort:
  196.           Inc(BadXFers);
  197.           IF XFerFlag=AbortXfer THEN
  198.           BEGIN
  199.             IF FileRec(FloFile).mode<>fmClosed THEN CLOSE(FloFile);
  200.             UnMarkNodeBusy(BusyFile);
  201.             Exit;
  202.           END;
  203.         END;
  204.       END;
  205.     END;
  206.     IF XFerFlag=SendRspFile THEN
  207.     BEGIN
  208.       DoAfter:=DeleteAfter;
  209.       FLOFlag:=False;
  210.       SAddress:=Call;
  211.       Call:=OAddress;
  212.       AddTpl(RspFile,'FOOT',TempSr);
  213.       Call:=SAddress;
  214.       TxFName:=RspFile;
  215.       OutboundName:=RspFile;
  216.       IF Cfg.Request.RspAsPkt THEN Goto SendIt ELSE GOTO SendIt2;
  217.     END;
  218.     HoldName:=HoldAreaPath(Call,False);
  219.     IF NOT FLOFlag THEN {!}
  220.     BEGIN
  221.       IF IsCaller THEN ch:='D' ELSE ch:='H';
  222.       IF OutboundName='' THEN OutboundName:=HoldFileName(Call,False)+ch+'UT';
  223.       ExtFlags[3]:='O';
  224.     END ELSE
  225.     BEGIN
  226. NxtOut:
  227.       ch:=OutBoundName[Length(OutBoundName)-2];
  228.       i:=POS(ch,ExtFlags);
  229.       IF i<NUMFLAGS THEN
  230.       BEGIN
  231.         OutBoundName[Length(OutBoundName)-2]:=ExtFlags[i+1];
  232.         IF (ExtFlags[i+1]='H') And (IsCaller) THEN GOTO NxtOut;
  233.       END ELSE
  234.         IF NOT FLOFlag THEN
  235.         BEGIN
  236.           ExtFlags[3]:='F';
  237.           IF IsCaller THEN ch:='D' ELSE ch:='H';
  238.           OutBoundName:=ForceExtension(OutBoundName,ch+'LO');
  239.           FLOFlag:=TRUE;
  240.         END ELSE
  241.         BEGIN
  242.           UnMarkNodeBusy(BusyFile);
  243. NextAka:
  244.           Inc(AkaNum);
  245.           IF (AkaNum<=MaxAddresses) And (RemAka[AkaNum].Zone<>0) THEN
  246.           BEGIN
  247.             Call:=RemAka[AkaNum];
  248.             AddLog(':','Sending to AKA: '+Address2Str(Call));
  249.             XFerFlag:=InitialXfer;
  250.             GOTO DoItAgain;
  251.           END;
  252.           OutBoundName:='';
  253.           TxFName:='';
  254.           Integer(TxBuf^):=0;
  255.           FLOFlag:=FALSE;
  256.           EXIT;
  257.         END;
  258.     END;
  259. SendIt:
  260.     IF OutBoundName<>'' THEN
  261.     BEGIN
  262.       IF NOT ExistFile(OutBoundName) THEN GOTO NxtOut;
  263.       IF FLOFlag THEN GOTO RDFLO;
  264.       TxFName:=OutBoundName;
  265.       ASSIGN(TxFile,TxFName); FileMode:=ShareRead+ShareDenyW;
  266.       RESET(TxFile,1);
  267.       IF IoResult=5 THEN
  268.       BEGIN
  269.         AddLog('!','Access denied to: '+OutboundName);
  270.         GOTO NxtOut;
  271.       END;
  272.       FindFirst(TxFName,AnyFile,f);
  273.       FindClose(f);
  274.       ShowCurrentFileName(TxFName,0,f.size,95,FALSE);
  275.       UnPackTime(f.time,dt);
  276.       WITH dt DO
  277.       BEGIN
  278.         s:=InventPktName+#0+Long2Str(f.size)+' '+OctalL(GetUnixDate(year,month,day,hour,min,sec))+' 00'+#0;
  279.       END;
  280.       Move(s[1],TxBuf^,Length(s));
  281.       DoAfter:=DeleteAfter;
  282.       TxLen:=f.Size;
  283.       TxDt1.d:=Today;
  284.       TxDt1.t:=CurrentTime;
  285.     END ELSE
  286.     BEGIN
  287. RdFLO:
  288.       IF FileRec(FLOFile).Mode=fmclosed THEN
  289.       BEGIN
  290.         BadXfers:=0;
  291.         ASSIGN(FLOFile,OutBoundName); FileMode:=ShareRW+ShareDenyW;
  292.         RESET(FLOFile,1);
  293.         IF IORESULT<>0 THEN GOTO NxtOut;
  294.       END;
  295.       FLONamePos:=FilePos(FLOFile);
  296.       i:=0;
  297.       ReadLine(FLOFile,TxFName);
  298.       IF (EoF(FLOFile)) AND (TxFName='') THEN
  299.       BEGIN
  300.         CLOSE(FLOFile);
  301.         IF BadXFers=0 THEN DeleteFile(OutBoundName);
  302.         GOTO NxtOut;
  303.       END;
  304.       IF TxFName<>'' THEN
  305.       BEGIN
  306.         CASE TxFName[1] OF
  307.           '~',
  308.           ';' : GOTO RdFLO;
  309.           TruncAfter,
  310.           DeleteAfter,
  311.           ShowDeleteAfter : BEGIN
  312.                                 DoAfter:=TxFName[1];
  313.                                 Delete(TxFName,1,1);
  314.                               END;
  315.           ELSE DoAfter:=NothingAfter;
  316.         END;
  317.       END ELSE
  318.         GOTO RDFLO;
  319. SendIt2:
  320.       s:=JustFileName(TxFName)+#0;
  321.       Move(s[1],TxBuf^,Length(s));
  322.       IF TxFName<>'' THEN
  323.       BEGIN
  324.         IF XFerFlag=AbortXFer THEN GOTO Abort;
  325.  
  326.         IF NOT isCaller AND ((CurrentEvent.Typ AND etNoFiles)<>0) AND
  327.            (StUpCase(Copy(TxFName, 1, Length(Cfg.Outbound)))<>StUpCase(Cfg.Outbound)) THEN
  328.         BEGIN
  329.           Inc(BadXFers);
  330.           GOTO RDFLO;
  331.         END;
  332.  
  333.         ASSIGN(TxFile,TxFName); FileMode:=ShareRead+ShareDenyW;
  334.         RESET(TxFile,1);
  335.         IF IORESULT<>0 THEN GOTO SkipName;
  336.         FindFirst(TxFName,AnyFile,f);
  337.         FindClose(f);
  338.         ShowCurrentFileName(TxFName,0,f.size,95,FALSE);
  339.         i:=Length(s);
  340.         UnPackTime(f.time,dt);
  341.         WITH dt DO
  342.         BEGIN
  343.           s:=Long2Str(f.Size)+' '+OctalL(GetUnixDate(year,month,day,hour,min,sec))+' 00'+#0;
  344.         END;
  345.         MOVE(s[1],BufferType(TxBuf^)[i],Length(s));
  346.         TxDt1.d:=Today;
  347.         TxDt1.t:=CurrentTime;
  348.         TxLen:=f.Size;
  349.       END;
  350.     END;
  351. {$IFDEF JDebug}
  352.     FastWrite('END GetFName ',1,1,7);
  353. {$ENDIF}
  354.   END;
  355.  
  356.   PROCEDURE TxByte(c: Byte);
  357.   LABEL
  358.     FallThrough1;
  359.   BEGIN
  360.     CASE c OF
  361.       Cr : IF LastSent=Integer('@') THEN GOTO FallThrough1;
  362.       Dle,
  363.       Xon,
  364.       XOff: BEGIN
  365. FallThrough1:
  366.               ComPort^.WriteByte(Dle, False);
  367.               c:=c XOR $40;
  368.             END;
  369.     END;
  370.     LastSent:=c;
  371.     ComPort^.WriteByte(c, False);
  372.   END;
  373.  
  374.   PROCEDURE SendPkt32(Buf: Pointer; Len: Word; Typ: Integer);
  375.   VAR
  376.     crc32 : LongInt;
  377.     i     : Word;
  378.   BEGIN
  379. {$IFDEF JDebug}
  380.     FastWrite('SendPkt32 ',1,1,7);
  381. {$ENDIF}
  382.     ShowErrorCheckingMethod('J-Send CRC32',False);
  383.     ComPort^.WriteByte(Dle, False);
  384.     ComPort^.WriteByte(PktStrtChr32 Xor $40, False);
  385.     Crc32:=$ffffffff;
  386.     IF Len>0 THEN
  387.     BEGIN
  388.       FOR i:=0 To Len DO
  389.         TxByte(BufferType(Buf^)[i]);
  390.       FOR i:=0 To Len DO
  391.         Crc32:=UpdCrc32(BufferType(Buf^)[i],Crc32);
  392.     END;
  393.     ComPort^.WriteByte(Byte(Typ), False);
  394.     Crc32:=UpdCrc32(Byte(Typ),Crc32);
  395.     ComPort^.WriteByte(Dle, False);
  396.     ComPort^.WriteByte(PktEndChr Xor $40, False);
  397.     TxByte(BYTE(Crc32 Shr 24));
  398.     TxByte(BYTE(Crc32 Shr 16));
  399.     TxByte(BYTE(Crc32 Shr 8));
  400.     TxByte(BYTE(Crc32));
  401.     ComPort^.FlushTx;
  402. {$IFDEF JDebug}
  403.     FastWrite('END SendPkt32 ',1,1,7);
  404. {$ENDIF}
  405.   END;
  406.  
  407.   PROCEDURE SendPkt(Buf: Pointer; Len: Word; Typ: Integer);
  408.   VAR
  409.     i, Crc16 : Word;
  410.   BEGIN
  411.     LastSent:=0;
  412.     IF ((SharedCap And CanCrc32)<>0) AND (Typ=BlkPkt) THEN
  413.       SendPkt32(Buf,Len,Typ)
  414.     ELSE
  415.     BEGIN
  416. {$IFDEF JDebug}
  417.       FastWrite('SendPkt16 ',1,1,7);
  418. {$ENDIF}
  419.       ShowErrorCheckingMethod('J-Send CRC16',False);
  420.       ComPort^.WriteByte(Dle, False);
  421.       ComPort^.WriteByte(PktStrtChr Xor $40, False);
  422.       Crc16:=0;
  423.       IF Len>0 THEN
  424.       BEGIN
  425.         FOR i:=0 To Len DO
  426.           TxByte(BufferType(Buf^)[i]);
  427.         FOR i:=0 To Len DO
  428.           Crc16:=UpdCrc16(BufferType(Buf^)[i],Crc16);
  429.       END;
  430.       ComPort^.WriteByte(Byte(Typ), False);
  431.       Crc16:=UpdCrc16(Byte(Typ),Crc16);
  432.       ComPort^.WriteByte(Dle, False);
  433.       ComPort^.WriteByte(PktEndChr XOR $40, False);
  434.       Crc16:=UpdCrc16(0,Crc16);
  435.       Crc16:=UpdCrc16(0,Crc16);
  436.       TxByte(Hi(Crc16));
  437.       TxByte(Lo(Crc16));
  438.       ComPort^.FlushTx;
  439. {$IFDEF JDebug}
  440.       FastWrite('SendPkt16 ',1,1,7);
  441. {$ENDIF}
  442.     END;
  443.     IF (TxFName<>'') AND (FileRec(TxFile).Mode<>fmClosed) THEN
  444.     BEGIN
  445.       ShowCurrentByte(FilePos(TxFile),False);
  446.       IF Len>3 THEN Dec(Len,3);
  447.       IF Typ=BLKPKT THEN ShowBlockSize(Len,False);
  448.     END;
  449.   END;
  450.  
  451.   FUNCTION ProcFName: LongInt;
  452.   VAR
  453.     dt        : DateTime;
  454.     SRec      : SearchRec;
  455.     Bytes, Power,
  456.     FileStart : LongInt;
  457.     i         : BYTE;
  458.     ok        : INTEGER;
  459.     BAddress  : TFidoAddress;
  460.     Found     : Boolean;
  461.     linebuf,
  462.     fileinfo  : PathStr;
  463.     BadWaZOOFile: PSimpDB;
  464.     BadWaZooRec : TBadWaZoo;
  465.   BEGIN
  466. {$IFDEF JDebug}
  467.     FastWrite('ProcFName ',1,1,7);
  468. {$ENDIF}
  469.     RXFname:='';
  470.     RxFileTime:=0;
  471.     i:=0;
  472.     WHILE BufferType(RxBuf^)[i]<>0 DO
  473.     BEGIN
  474.       RxFName:=RxFName+Char(BufferType(RxBuf^)[i]);
  475.       Inc(i);
  476.     END;
  477.     Inc(i);
  478.     FileInfo:='';
  479.     WHILE BufferType(RxBuf^)[i]<>0 DO
  480.     BEGIN
  481.       FileInfo:=FileInfo+Char(BufferType(RxBuf^)[i]);
  482.       Inc(i);
  483.     END;
  484.     Inc(i);
  485.     SharedCap:=BufferType(RxBuf^)[i] And (OURCAP or CANFREQ);
  486.     IF Byte(RxBuf^)=0 THEN
  487.     BEGIN
  488.       ProcFName:=0;
  489.       Exit;
  490.     END;
  491.     Replace(RxFName, ' ', '_', 0);
  492.     LineBuf:=StLoCase(RxFName);
  493.     RxLen:=-1;
  494.     IF Pos(' ',FileInfo)=0 THEN
  495.     BEGIN
  496.       AddLog('!','No file size in header');
  497.       ProcFName:=-1;
  498.       Exit;
  499.     END ELSE
  500.     BEGIN
  501.       Val(Copy(FileInfo,1,Pos(' ',FileInfo)-1),RxLen,ok);
  502.       power := 1;
  503.       WHILE FileInfo[Length(FileInfo)]<>' ' DO
  504.         Dec(Byte(FileInfo[0]));
  505.       Dec(Byte(FileInfo[0]));
  506.       FOR ok := Length(FileInfo) DOWNTO Pos(' ',FileInfo)+1 DO
  507.       BEGIN
  508.         RxFileTime:=RxFileTime+(Ord(FileInfo[ok])-$30)*power;
  509.         power := power * 8;
  510.       END;
  511.       WITH dt Do
  512.       BEGIN
  513.         UnPackUnix(RxFileTime,year,month,day,hour,min,sec);
  514.         PackTime(dt,RxFileTime);
  515.       END;
  516.     END;
  517.     Found:=False;
  518.     IF Reqstarted THEN BAddress:=ReqAddress ELSE BAddress:=OAddress;
  519.     New(BadWaZOOFile, Open(StartPath+PoPBadWaZooFileName, SizeOf(TBadWaZoo), False));
  520.     IF BadWaZOOFile<>Nil THEN
  521.     BEGIN
  522.       WHILE NOT Found AND BadWaZOOFile^.NextRec(BadWaZOORec, Keep) DO
  523.       BEGIN
  524.         IF CmpAdr(BadWaZooRec.Address,BAddress) And
  525.            (StUpCase(BadWaZooRec.FName)=StUpCase(LineBuf)) THEN
  526.           Found:=True
  527.         ELSE
  528.           BadWaZooFile^.Unlock(BadWaZooFile^.FilePos-1);
  529.       END;
  530.       IF Found THEN
  531.       BEGIN
  532.         BadWaZooFile^.DelRec(BadWaZooRec,BadWaZooFile^.FilePos-1);
  533.       END;
  534.       Dispose(BadWaZOOFile, Close);
  535.       Found:=((Found) AND (BadWaZooRec.FSize=RxLen) AND (BadWaZooRec.FTime=RxFileTime));
  536.     END;
  537.     IF Found THEN
  538.     BEGIN
  539.       RenameFile(Cfg.Inbound[BadWaZooRec.NodeStat]+BadWaZooRec.NewName, Cfg.Inbound[GlobNodeStat]+LineBuf);
  540.       RxFName:=LineBuf;
  541.     END ELSE
  542.     BEGIN
  543.       FINDFIRST(Cfg.Inbound[GlobNodeStat]+LineBuf, AnyFile, Srec);
  544.       IF DOSERROR = 0 THEN
  545.       BEGIN
  546.         IF (Srec.size = RxLen) AND (RxFileTime = Srec.Time) THEN
  547.         BEGIN
  548.           ShowError('Already have: ' + LineBuf,False,true,true);
  549.           ProcFName:=-1;
  550.           FindClose(Srec);
  551.           Exit;
  552.         END;
  553.         RxFName:=JustFileName(UniqueName(cfg.inbound[GlobNodeStat]+LineBuf));
  554.         ShowError('File renamed from: '+LineBuf+' to: '+RxFName, False, True, True);
  555.       END;
  556.       FindClose(Srec);
  557.     END;
  558.     Assign(RxFile,Cfg.Inbound[GlobNodeStat]+RxFName); FileMode:=ShareRW+ShareDenyRW;
  559.     Reset(RxFile,1);
  560.     IF IOResult<>0 THEN ReWrite(RxFile,1) ELSE Seek(RxFile, FileSize(RxFile));
  561.     FileStart:=FileSize(RxFile);
  562.     ShowCurrentFileName(RxFName,FileStart,RxLen,95,True);
  563.     Bytes:=RxLen-FileStart+10240;
  564.     IF Bytes>DiskAvail THEN
  565.     BEGIN
  566.       AddLog('!','Not enough disk space on drive');
  567.       Close(RxFile);
  568.       ProcFName:=-1;
  569.       Exit;
  570.     END;
  571.     RxDt1.d:=Today;
  572.     RxDt1.t:=CurrentTime;
  573.     ProcFName:=FileStart;
  574. {$IFDEF JDebug}
  575.     FastWrite('END ProcFName ',1,1,7);
  576. {$ENDIF}
  577.   END;
  578.  
  579.   FUNCTION RcvRawByte: Integer;
  580.   VAR
  581.     TimeVal : EventTimer;
  582.   BEGIN
  583.     IF ComPort^.Keypressed THEN
  584.     BEGIN
  585.       RcvRawByte:=ComPort^.ReadByte;
  586.       Exit;
  587.     END;
  588.     IF NOT ComPort^.Carrier THEN
  589.     BEGIN
  590.       RcvRawByte:=NOCARRIER;
  591.       Exit;
  592.     END;
  593.     IF (WaitFlag=0) AND (NOT ComPort^.KeyPressed) THEN
  594.     BEGIN
  595.       RcvRawByte:=BUFEMPTY;
  596.       Exit;
  597.     END;
  598.     NewTimerSecs(TimeVal, TimeOutSecs);
  599.     WHILE NOT ComPort^.Keypressed DO
  600.     BEGIN
  601.       IF NOT ComPort^.Carrier THEN
  602.       BEGIN
  603.         RcvRawByte:=NOCARRIER;
  604.         Exit;
  605.       END;
  606.       IF TimerExpired(TimeVal) THEN
  607.       BEGIN
  608.         RcvRawByte:=BUFEMPTY;
  609.         Exit;
  610.       END;
  611. {     GiveUpTime;}
  612.     END;
  613.     RcvRawByte:=ComPort^.ReadByte;
  614.   END;
  615.  
  616.   FUNCTION RxByte: Integer;
  617.   VAR
  618.     c : Integer;
  619.     w : Byte;
  620.   BEGIN
  621.     c:=RcvRawByte;
  622.     IF Lo(c)=DLE THEN
  623.     BEGIN
  624.       w:=WaitFlag;
  625.       WaitFlag:=1;
  626.       c:=RcvRawByte;
  627.       IF c>=0 THEN
  628.       BEGIN
  629.         c:=c XOR $40;
  630.         CASE c OF
  631.           PKTSTRTCHR   : c:=PKTSTRT;
  632.           PKTSTRTCHR32 : c:=PKTSTRT32;
  633.           PKTENDCHR    : c:=PKTEND;
  634.         END;
  635.       END;
  636.       WaitFlag:=w;
  637.     END;
  638.     RxByte:=c;
  639.   END;
  640.  
  641.   FUNCTION RcvPkt: Byte;
  642.   LABEL
  643.     FallThrough;
  644.   VAR
  645.     i : Byte;
  646.     c : Integer;
  647.     PktCrc : LongInt;
  648.   BEGIN
  649. {$IFDEF JDebug}
  650.     FastWrite('RcvPkt ',1,1,7);
  651. {$ENDIF}
  652.     IF GotESC THEN
  653.     BEGIN
  654.       AddLog('!','Keyboard Escape');
  655.       RcvPkt:=HALTPKT;
  656.       Exit;
  657.     END;
  658.     WaitFlag:=0;
  659.     IF p=$ffff THEN
  660.     BEGIN
  661.       REPEAT
  662.         c:=RxByte;
  663.       UNTIL (c<0) And (c<>PKTEND);
  664.       CASE c OF
  665.         PKTSTRT : BEGIN
  666.                     ShowErrorCheckingMethod('J-Receive CRC16',True);
  667.                     RXCrc32:=False;
  668.                     p:=0;
  669.                     rCrc16:=0;
  670.                   END;
  671.         PKTSTRT32:BEGIN
  672.                     ShowErrorCheckingMethod('J-Receive CRC32',True);
  673.                     RXCrc32:=True;
  674.                     p:=0;
  675.                     rCrc32:=$ffffffff;
  676.                   END;
  677.         NOCARRIER:BEGIN
  678.                     AddLog('!','No Carrier');
  679.                     RcvPkt:=HALTPKT;
  680.                     Exit;
  681.                   END;
  682.         ELSE      BEGIN
  683.                     RcvPkt:=NOPKT;
  684.                     Exit;
  685.                   END;
  686.       END;
  687.     END;
  688.     c:=RxByte;
  689.     WHILE (c>=0) AND (p<RxBufMax) DO
  690.     BEGIN
  691.       BufferType(RxBuf^)[p]:=Byte(c);
  692.       IF RxCrc32 THEN rCrc32:=UpdCrc32(Byte(c),rCrc32) ELSE rCrc16:=UpdCrc16(Byte(c),rCrc16);
  693.       Inc(p);
  694.       c:=RxByte;
  695.     END;
  696.  
  697.     CASE c OF
  698.       PKTEND  : BEGIN
  699.                   IF Not RxCrc32 THEN
  700.                   BEGIN
  701.                     rCrc16:=UpdCrc16(0,rCrc16);
  702.                     rCrc16:=UpdCrc16(0,rCrc16);
  703.                   END;
  704.                   WaitFlag:=1;
  705.                   PktCrc:=0;
  706.                   FOR i:=1 TO 2+2*Byte(RxCrc32) DO
  707.                   BEGIN
  708.                     c:=RxByte;
  709.                     IF c<0 THEN Goto FallThrough;
  710.                     PktCrc:=LongInt(PktCrc Shl 8) + Byte(c);
  711.                   END;
  712.                   IF ((RxCrc32) And (PktCrc=rCrc32)) Or (PktCrc=rCrc16) THEN
  713.                   BEGIN
  714.                     Dec(p);
  715.                     RxBlkLen:=p;
  716.                     RcvPkt:=BufferType(RxBuf^)[p];
  717.                     IF p>4 THEN Dec(p,4);
  718.                     IF BufferType(RxBuf^)[p+4]=BLKPKT THEN ShowBlockSize(p,True);
  719.                     p:=$ffff;
  720.                     Exit;
  721.                   END ELSE
  722.                     ShowError('CRC Error',True,False,True);
  723.                   Goto FallThrough;
  724.                 END;
  725.       BUFEMPTY: BEGIN
  726.                   RcvPkt:=NOPKT;
  727.                   Exit;
  728.                 END;
  729.       PKTSTRT : BEGIN
  730.                   RxCrc32:=False;
  731.                   p:=0;
  732.                   rCrc16:=0;
  733.                   RcvPkt:=BADPKT;
  734.                   Exit;
  735.                 END;
  736.       PKTSTRT32:BEGIN
  737.                   RxCrc32:=True;
  738.                   p:=0;
  739.                   rCrc32:=$ffffffff;
  740.                   RcvPkt:=BADPKT;
  741.                   Exit;
  742.                 END;
  743.       ELSE      BEGIN
  744. FallThrough:
  745.                   IF c=NOCARRIER THEN
  746.                   BEGIN
  747.                     AddLog('!','No carrier');
  748.                     RcvPkt:=HALTPKT;
  749.                   END ELSE
  750.                   BEGIN
  751.                     RcvPkt:=BADPKT;
  752.                   END;
  753.                   p:=$ffff;
  754.                   Exit;
  755.                 END;
  756.     END;
  757.   END;
  758.  
  759.   PROCEDURE RxClose(XFerFlag: Word);
  760.   VAR
  761.     NameBuf     : PathStr;
  762.     BadWaZooFile: PSimpDB;
  763.     BadWaZooRec : TBadWaZoo;
  764.     BAddress    : TFidoAddress;
  765.   BEGIN
  766. {$IFDEF JDebug}
  767.     FastWrite('RxClose ',1,1,7);
  768. {$ENDIF}
  769.     IF RxFileTime<>0 THEN SetFTime(RxFile,RxFileTime);
  770.     IF FileRec(RxFile).mode<>fmClosed THEN CLOSE(RxFile);
  771.     IF XFerFlag=FAILEDXFER THEN
  772.     BEGIN
  773.       IF RxPos>0 THEN
  774.       BEGIN
  775.         AddLog('!','File '+RxFName+' aborted - saving resume information');
  776.         NameBuf:=UniqueName(Cfg.Inbound[GlobNodeStat]+'BADWAZOO.000');
  777.         RenameFile(Cfg.Inbound[GlobNodeStat]+RxFName,NameBuf);
  778.         IF Reqstarted THEN BAddress:=ReqAddress ELSE BAddress:=OAddress;
  779.         New(BadWaZOOFile, Open(StartPath+PoPBadWaZooFileName, SizeOf(TBadWaZoo), True));
  780.         IF BadWaZOOFile<>NIL THEN
  781.         BEGIN
  782.           FillChar(BadWaZooRec, SizeOf(BadWaZooRec), 0);
  783.           WITH BadWaZooRec DO
  784.           BEGIN
  785.             Address:=BAddress;
  786.             FName:=JustFileName(RxFName);
  787.             FSize:=RxLen;
  788.             FTime:=RxFileTime;
  789.             NewName:=StUpCase(JustFileName(NameBuf));
  790.             NodeStat:=GlobNodeStat;
  791.           END;
  792.           BadWaZooFile^.AddRec(BadWazooRec);
  793.           Dispose(BadWaZooFile, Close);
  794.         END ELSE
  795.           AddLog('!', 'Error opening: '+PoPBadWaZooFileName);
  796.       END ELSE
  797.         DeleteFile(Cfg.Inbound[GlobNodeStat]+RxFName);
  798.     END;
  799. {$IFDEF JDebug}
  800.     FastWrite('END RxClose ',1,1,7);
  801. {$ENDIF}
  802.   END;
  803.  
  804.   PROCEDURE EndBatch;
  805.   LABEL
  806.     Reject;
  807.   VAR
  808.     i : Byte;
  809.     Done : Boolean;
  810.     TimeOuts : Word;
  811.     TimeVal, BrainDead : EventTimer;
  812.   BEGIN
  813. {$IFDEF JDebug}
  814.     FastWrite('EndBatch ',1,1,7);
  815. {$ENDIF}
  816.     Done:=False; TimeOuts:=0;
  817.     NewTimerSecs(BrainDead, 120);
  818.     GOTO Reject;
  819.  
  820.     WHILE Not Done AND Not TimerExpired(BrainDead) DO
  821.     BEGIN
  822.       CASE RcvPkt OF
  823.         NOPKT,
  824.         BADPKT : BEGIN
  825.                    IF TimerExpired(TimeVal) THEN
  826.                    BEGIN
  827.                      Inc(TimeOuts);
  828.                      IF TimeOuts>2 THEN Done:=True ELSE GOTO Reject;
  829.                    END;
  830.                  END;
  831.         HALTPKT,
  832.         HALTACKPKT: Done:=True;
  833.         ELSE     BEGIN
  834.                    TimeOuts:=0;
  835. Reject:
  836.                    SendPkt(Nil,0,HALTPKT);
  837.                    NewTimerSecs(TimeVal, TimeoutSecs);
  838.                  END;
  839.       END;
  840.     END;
  841.     FOR i:=0 TO 9 DO
  842.       SendPkt(Nil,0,HALTACKPKT);
  843.     WHILE NOT ComPort^.OutEmpty DO
  844. {     GiveUpTime};
  845. {$IFDEF JDebug}
  846.     FastWrite('END EndBatch ',1,1,7);
  847. {$ENDIF}
  848.   END;
  849.  
  850.   PROCEDURE MarkDone(CONST Name: PathStr);
  851.   VAR
  852.     f : FILE;
  853.     i : LONGINT;
  854.     s:STRING;
  855.     done:BOOLEAN;
  856.     Ch : Char;
  857.   BEGIN
  858. {$IFDEF JDebug}
  859.     FastWrite('MarkDone ',1,1,7);
  860. {$ENDIF}
  861.     Assign(f, Name); FileMode:=ShareRW+ShareDenyRW;
  862.     Reset(f, 1);
  863.     i:=0;
  864.     Done:=False;
  865.     REPEAT
  866.       i:=FilePos(f);
  867.       ReadLine(f,s);
  868.       IF Copy(s,1,1)<>';' THEN
  869.       BEGIN
  870.         Seek(f,i);
  871.         ch:=';';
  872.         BlockWrite(f,ch,1);
  873.         Done:=True;
  874.       END;
  875.     UNTIL Done Or (EoF(f));
  876.     Close(f);
  877. {$IFDEF JDebug}
  878.     FastWrite('END MarkDone ',1,1,7);
  879. {$ENDIF}
  880.   END;
  881.  
  882.   FUNCTION GetFileReq(ReqStarted: Boolean): Boolean;
  883.   VAR
  884.     GotOne  : Boolean;
  885.     LineBuf,
  886.     ReqName : PathStr;
  887.     ReqFile : File;
  888.   BEGIN
  889. {$IFDEF JDebug}
  890.     FastWrite('GetFileReq ',1,1,7);
  891. {$ENDIF}
  892.     GetFileReq:=False;
  893.     GotOne:=False;
  894.     WHILE NOT GotOne AND (ReqAkaNum<=MaxAddresses) AND ((ReqAkaNum=0) OR (RemAka[ReqAkaNum].Zone<>0)) DO
  895.     BEGIN
  896.       ReqName:=HoldFileName(ReqAddress,False)+'REQ';
  897.       IF ExistFile(ReqName) THEN
  898.       BEGIN
  899.         IF ReqStarted THEN MarkDone(ReqName);
  900.         IF NOT (WzFreq IN RemHello.Capabilities) THEN { Capabilities?? }
  901.         BEGIN
  902.           AddLog('!','File request declined');
  903.           ReqAkaNum:=MaxAddresses+1;
  904.           Exit;
  905.         END ELSE
  906.           IF (SharedCap AND CANFREQ)=0 THEN
  907.           BEGIN
  908.             AddLog('!','Remote can''t handle file request');
  909.             ReqAkaNum:=MaxAddresses+1;
  910.             Exit;
  911.           END ELSE
  912.           BEGIN
  913.             Assign(ReqFile, ReqName); FileMode:=ShareRead+ShareDenyW;
  914.             Reset(ReqFile,1);
  915.             IF IOResult=0 THEN
  916.             BEGIN
  917.               WHILE NOT EoF(ReqFile) AND NOT GotOne DO
  918.               BEGIN
  919.                 ReadLine(ReqFile, LineBuf);
  920.                 IF (Copy(LineBuf,1,1)<>';') And (LineBuf<>'') THEN
  921.                 BEGIN
  922.                   AddLog('+','Requesting: '+LineBuf);
  923.                   LineBuf:=LineBuf+#0+Char(SharedCap);
  924.                   Move(LineBuf[1],RxBuf^,Length(LineBuf));
  925.                   GotOne:=True;
  926.                 END;
  927.               END;
  928.               Close(ReqFile);
  929.               IF NOT GotOne THEN DeleteFile(ReqName);
  930.             END;
  931.           END;
  932.       END;
  933.       IF NOT GotOne THEN
  934.       BEGIN
  935.         Inc(ReqAkaNum);
  936.         IF (ReqAkaNum<=MaxAddresses) AND (RemAka[ReqAkaNum].Zone<>0) THEN
  937.         BEGIN
  938.           ReqAddress:=RemAka[ReqAkaNum];
  939.           ReqStarted:=False;
  940.         END;
  941.       END;
  942.     END;
  943.     GetFileReq:=GotOne;
  944. {$IFDEF JDebug}
  945.     FastWrite('END GetFileReq ',1,1,7);
  946. {$ENDIF}
  947.   END;
  948.  
  949.   FUNCTION GetReqName: Boolean;
  950.   VAR
  951.     Tmp       : PathStr;
  952.     dt        : DateTime;
  953.     TransTime : LongInt;
  954.   BEGIN
  955. {$IFDEF JDebug}
  956.     FastWrite('GetReqName ',1,1,7);
  957. {$ENDIF}
  958.     DoAfter:=NothingAfter;
  959.     GetReqName:=False;
  960.     REPEAT
  961.       TxFName:=GetNextFileToSend(FreeArea);
  962.       IF TxFName<>'' THEN
  963.       BEGIN
  964.         IF (MaxReqFiles>0) OR (FreeArea=faTotally) THEN
  965.         BEGIN
  966.           IF (MaxReqBytes-ReqSr.Size>=0) OR (FreeArea=faTotally) THEN
  967.           BEGIN
  968.             TransTime:=ReqSr.Size DIV (ComPort^.GetBaudRate DIV 10);
  969.             IF (TimeToNoMoreRequest>TransTime) AND
  970.                ((MaxReqTime>TransTime) OR (FreeArea=faTotally)) THEN
  971.             BEGIN
  972.               Assign(TxFile, TxFName); FileMode:=ShareRead+ShareDenyW;
  973.               Reset(TxFile,1);
  974.               IF IOResult=5 THEN
  975.                 AddLog('!','Access denied to: '+TxFName)
  976.               ELSE
  977.                  Break;
  978.             END ELSE
  979.             BEGIN
  980.               AddTpl(rspfile,'TIMEOUT',reqsr);
  981.               AddLog('#','Not enough time (Lft: '+
  982.                          TimeToTimeString('Hh:mm:ss',Min(MaxReqTime,TimeToNoMoreRequest))+
  983.                          '/Tfr: '+
  984.                          TimeToTimeString('Hh:mm:ss',TransTime)+'): '+TxFName);
  985.             END;
  986.           END ELSE
  987.           BEGIN
  988.             AddTpl(RspFile,'TOOBIG',ReqSr);
  989.             AddLog('#','File too big ('+Long2Str(MaxReqBytes)+'): '+TxFName);
  990.           END;
  991.         END ELSE
  992.         BEGIN
  993.           AddTpl(rspfile,'TOOMANY',reqsr);
  994.           AddLog('#','Too many files '+TxFName);
  995.         END ;
  996.       END;
  997.     UNTIL TxFName='';
  998.     IF TxFName<>'' THEN
  999.     BEGIN
  1000.       UnPackTime(ReqSr.time,dt);
  1001.       WITH dt DO
  1002.       BEGIN
  1003.         Tmp:=JustFileName(TxFName)+#0+Long2Str(FileSize(TxFile))+' '+OctalL(GetUnixDate(year,month,day,hour,min,sec))+' 00'+#0;
  1004.       END;
  1005.       Move(Tmp[1],TxBuf^,Length(Tmp));
  1006.       TxLen:=ReqSr.Size;
  1007.       ShowCurrentFileName(TxFName,0,ReqSr.Size,95,False);
  1008.       TxDt1.d:=Today;
  1009.       TxDt1.t:=CurrentTime;
  1010.       GetReqName:=True;
  1011.     END;
  1012. {$IFDEF JDebug}
  1013.     FastWrite('END GetReqName ',1,1,7);
  1014. {$ENDIF}
  1015.   END;
  1016.  
  1017.   BEGIN
  1018.     ComPort^.SetXOn(Off);
  1019.     SharedCap:=0; TotalBytes:=0;
  1020.     OURCAP:=CANCRC32;
  1021.     IF ((CurrentEvent.typ AND etRequests)=etRequests) AND (ReqOk) AND
  1022.         (NOT NodesRec.DisallowReq) THEN OurCap:=OurCap OR CANFREQ;
  1023.     IF NOT GetMemCheck(TxBuf,4096) THEN Exit;
  1024.     IF NOT GetMemCheck(RxBuf,5000) THEN
  1025.     BEGIN
  1026.       FreeMem(TxBuf, 4096);
  1027.       Exit;
  1028.     END;
  1029.     TxFName:='';
  1030.     RxFName:='';
  1031.     RxBufMax:=4096;
  1032.  
  1033.     AkaNum:=0; ReqAkaNum:=0;
  1034.     MustWriteDRI:=False;
  1035.     OAddress:=Call;
  1036.     ReqAddress:=Call;
  1037.     TxInhibit:=False;
  1038.     LastRPosTime:=0; XmitRetry.StartTics:=0;
  1039.     TimeOutSecs:=40960 DIV ComPort^.GetBaudRate;
  1040.     IF TimeOutSecs<10 THEN TimeOutSecs:=10;
  1041.     NewTimerSecs(BrainDead, 120);
  1042.     TxBlkMax:=ComPort^.GetBaudRate DIV 300 * 128;
  1043.     IF TxBlkMax>BUFMAX THEN TxBlkMax:=BUFMAX;
  1044.     TxBlkLen:=TxBlkMax;
  1045.     GoodBytes:=0; GoodNeeded:=0;
  1046.     SendingReq:=False; FSent:=0;
  1047.     p:=$ffff;
  1048.     RxCRC32:=FALSE;
  1049.     XState:=XSENDFNAME;
  1050.     FileRec(FLOFile).Mode:=FmClosed;
  1051.     FileRec(TxFile).Mode:=FmClosed;
  1052.     FileRec(RxFile).Mode:=FmClosed;
  1053.     GetFName(INITIALXFER);
  1054.  
  1055.     DiskAvail:=DriveFree(Byte(Cfg.Inbound[GlobNodeStat][1])-64);
  1056.     RPosRetry.StartTics:=0; RPosCount:=0;
  1057.     AttemptingReq:=False; ReqStarted:=False;
  1058.     RState:=RRCVFNAME;
  1059.  
  1060.     StartTime.d := Today;
  1061.     StartTime.t := CurrentTime;
  1062.     REPEAT
  1063. {$IFDEF JDebug}
  1064.       FastWrite('Main loop XS='+Long2Str(XState)+' RS='+Long2Str(RState) ,1,1,7);
  1065. {$ENDIF}
  1066.       IF TimerExpired(BrainDead) THEN
  1067.       BEGIN
  1068.         AddLog('!','Other end died');
  1069.         GOTO GiveUp;
  1070.       END;
  1071.  
  1072.       IF (XMitRetry.StartTics>0) And (TimerExpired(XMitRetry)) THEN
  1073.       BEGIN
  1074.         ShowError('TimeOut',False,False,False);
  1075.         XmitRetry.StartTics:=0;
  1076.         CASE XState OF
  1077.           XRCVFNACK   : XState:=XSENDFNAME;
  1078.           XRCVFRNAKACK: XState:=XSENDFREQNAK;
  1079.           XRCVEOFACK  : BEGIN
  1080.                           TxPos:=LastTx;
  1081.  
  1082.                           Seek(TxFile,TxPos);
  1083.                           IF IOResult<>0 THEN
  1084.                           BEGIN
  1085.                             ShowError('Seek Error '+TxFName,False,True,True);
  1086.                             GOTO GiveUp;
  1087.                           END;
  1088.                           XState:=XSENDBLK;
  1089.                         END;
  1090.         END; {case}
  1091.       END;
  1092.  
  1093.       CASE XState OF
  1094.         XSENDBLK: BEGIN
  1095.           IF NOT TxInhibit THEN
  1096.           BEGIN
  1097.             LongInt(TxBuf^):=TxPos;
  1098.             LastTx:=TXPos;
  1099.             BlockRead(TxFile, BufferType(TxBuf^)[4], TxBlkLen, BlkLen);
  1100.             Inc(TxPos,BlkLen);
  1101.             SendPkt(TxBuf, BlkLen+3, BLKPKT);
  1102.             FSent:=1;
  1103.             IF (TxPos>=TxLen) OR (BlkLen<TxBlkLen) THEN
  1104.             BEGIN
  1105.               NewTimerSecs(XMitRetry, TimeOutSecs);
  1106.               XState:=XRCVEOFACK;
  1107.             END ELSE
  1108.               NewTimerSecs(BrainDead, 120);
  1109.             Inc(GoodBytes,TxBlkLen);
  1110.             IF (TxBlkLen<TxBlkMax) AND (GoodBytes>=GoodNeeded) THEN
  1111.             BEGIN
  1112.               TxBlkLen:=TxBlkLen SHL 1;
  1113.               GoodBytes:=0;
  1114.             END;
  1115.           END;
  1116.         END;
  1117.         XSENDFNAME: BEGIN
  1118.           BlkLen:=0;
  1119.           WHILE BufferType(TxBuf^)[BlkLen]<>0 DO
  1120.             Inc(BlkLen);
  1121.           Inc(BlkLen);
  1122.           WHILE BufferType(TxBuf^)[BlkLen]<>0 DO
  1123.             Inc(BlkLen);
  1124.           Inc(BlkLen);
  1125.           BufferType(TxBuf^)[BlkLen]:=OURCAP;
  1126.           SendPkt(TxBuf, BlkLen, FNAMEPKT);
  1127.           NewTimerSecs(XMitRetry, TimeOutSecs);
  1128.           XState:=XRCVFNACK;
  1129.         END;
  1130.         XSENDFREQNAK: BEGIN
  1131.           SendPkt(Nil, 0, FREQNAKPKT);
  1132.           NewTimerSecs(XMitRetry, TimeOutSecs);
  1133.           XState:=XRCVFRNAKACK;
  1134.         END;
  1135.       END;
  1136.  
  1137.       PktType:=RcvPkt;
  1138.       WHILE PktType<>NOPKT DO
  1139.       BEGIN
  1140.         IF PktType<>BADPKT THEN NewTimerSecs(BrainDead, 120);
  1141.         CASE PktType OF
  1142.           BADPKT,
  1143.           BLKPKT : BEGIN
  1144.                      IF RState=RRCVBLK THEN
  1145.                      BEGIN
  1146.                        IF (PktType=BADPKT)  Or (LongInt(RxBuf^)<>RxPos) THEN
  1147.                        BEGIN
  1148.                          IF PktType=BLKPKT THEN
  1149.                          BEGIN
  1150.                            IF LongInt(RxBuf^)<LastBlkPos THEN
  1151.                            BEGIN
  1152.                              RPosRetry.StartTics:=0; RPosCount:=0;
  1153.                            END;
  1154.                            LastBlkPos:=LongInt(RxBuf^);
  1155.                          END;
  1156.                          IF {(RPosRetry>0) And} (TimerExpired(RPosRetry)) THEN
  1157.                          BEGIN
  1158.                            IF RPosCount>4 THEN
  1159.                            BEGIN
  1160.                              IF (XState<>0) And Not (IsCaller) And Not (TxInhibit) THEN
  1161.                              BEGIN
  1162.                                TxInhibit:=True;
  1163.                                AddLog('!','Dropping to one-way xfer');
  1164.                              END ELSE
  1165.                                GOTO GiveUp;
  1166.                              RPosCount:=0;
  1167.                            END;
  1168.                            Inc(RPosCount);
  1169.                            IF RPosCount=1 THEN Time(RPosStTime);
  1170.                            ShowError('Bad packet at '+Long2Str(RxPos),TRUE,FALSE,TRUE);
  1171.                            LongInt(RxBuf^):=RxPos;
  1172.                            MOVE(RPosStTime,BufferType(RxBuf^)[4],4);
  1173.                            SendPkt(RxBuf,7,RPOSPKT);
  1174.                            NewTimerSecs(RPosRetry, TimeOutSecs DIV 2);
  1175.                          END;
  1176.                        END ELSE
  1177.                        BEGIN
  1178.                          LastBlkPos:=RxPos;
  1179.                          RPosRetry.StartTics:=0; RPosCount:=0;
  1180.                          Dec(RxBlkLen,4);
  1181.                          BlockWrite(RxFile,BufferType(RxBuf^)[4],RxBlkLen);
  1182.                          i:=IORESULT;
  1183.                          IF i<>0 THEN
  1184.                          BEGIN
  1185.                            AddLog('!','Error '+Long2Str(i)+' writing '+RxFName);
  1186.                            GOTO GiveUp;
  1187.                          END;
  1188.                          ShowCurrentByte(FilePos(RxFile),True);
  1189.                          Dec(DiskAvail, RxBlkLen);
  1190.                          Inc(RxPos,RxBlkLen);
  1191.                          IF RxPos>=RxLen THEN
  1192.                          BEGIN
  1193.                            RxClose(GOODXFER);
  1194.                            FileReceived(JustFileName(RxFName),'J'+CrcStr(SharedCap AND CANCRC32=CANCRC32),TRUE);
  1195.                            Dec(RxLen,RxStPos);
  1196.                            Inc(TotalBytes, RxLen);
  1197.                            RState:=RRCVFNAME;
  1198.                          END;
  1199.                        END;
  1200.                      END;
  1201.                      IF RState=RRCVFNAME THEN SendPkt(NIL,0,EOFACKPKT);
  1202.                    END;
  1203.           FNAMEPKT : BEGIN
  1204.                        IF RState=RRCVFNAME THEN
  1205.                        BEGIN
  1206.                          RxPos:=ProcFName;
  1207.                          RxStPos:=RxPos;
  1208.                        END;
  1209.                        IF (RxFname='') AND GetFileReq(ReqStarted) THEN
  1210.                        BEGIN
  1211.                          i:=0;
  1212.                          WHILE BufferType(RxBuf^)[i]<>0 DO
  1213.                            Inc(i);
  1214.                          SendPkt(RxBuf,i+1,FREQPKT);
  1215.                          AttemptingReq:=TRUE;
  1216.                          ReqStarted:=FALSE;
  1217.                        END ELSE
  1218.                        BEGIN
  1219.                          IF AttemptingReq THEN
  1220.                          BEGIN
  1221.                            AttemptingReq:=FALSE;
  1222.                            ReqStarted:=TRUE;
  1223.                          END;
  1224.                          LongInt(RxBuf^):=RxPos;
  1225.                          BufferType(RxBuf^)[4]:=SharedCap;
  1226.                          SendPkt(RxBuf,4,FNACKPKT);
  1227.                          IF RxPos>-1 THEN
  1228.                          BEGIN
  1229.                            IF RxFName<>'' THEN RState:=RRCVBLK ELSE RState:=RDONE;
  1230.                          END ELSE
  1231.                            AddLog('+','Refusing '+JustFileName(RxFName));
  1232.                          IF RState=0 THEN TxInhibit:=False;
  1233.                          IF (XState=0) And (RState=0) THEN GOTO BreakOut;
  1234.                        END;
  1235.                      END;
  1236.           FNACKPKT: BEGIN
  1237.             IF XState=XRCVFNACK THEN
  1238.             BEGIN
  1239.               XmitRetry.StartTics:=0;
  1240.               IF TxFName<>'' THEN
  1241.               BEGIN
  1242.                 {shared cap}
  1243.                 IF RxBlkLen>4 THEN SharedCap:=BufferType(RxBuf^)[4] AND (OURCAP or CANFREQ);
  1244.                 TxPos:=LongInt(RxBuf^);
  1245.                 IF TxPos>-1 THEN
  1246.                 BEGIN
  1247.                   IF txPos<>0 THEN
  1248.                   BEGIN
  1249.                     ShowCurrentFileName(TxFName,TxPos,FileSize(TxFile),95,FALSE);
  1250.                   END;
  1251.                   TxStPos:=TxPos;
  1252.                   Seek(TxFile, TxPos);
  1253.                   IF IOResult<>0 THEN Goto GiveUp;
  1254.                   XState:=XSENDBLK;
  1255.                 END ELSE
  1256.                 BEGIN
  1257.                   Inc(BadXFers);
  1258.                   ShowError('Remote refused '+JustFileName(TxFName),False,True,False);
  1259.                   IF SendingReq THEN
  1260.                   BEGIN
  1261.                     SendingReq:=GetReqName;
  1262.                     IF Not SendingReq THEN GetFName(GoodXFer);
  1263.                   END ELSE
  1264.                   BEGIN
  1265.                     DoAfter:=NothingAfterRefuse;
  1266.                     GetFName(GoodXFer);
  1267.                   END;
  1268.                   XState:=XSENDFNAME;
  1269.                 END;
  1270.               END ELSE
  1271.               BEGIN
  1272.                 XState:=XDONE;
  1273.               END;
  1274.             END;
  1275.             IF XState+RState=0 THEN Goto BreakOut;
  1276.           END;
  1277.           FREQPKT : BEGIN
  1278.             IF XState=XRCVFNACK THEN
  1279.             BEGIN
  1280.               XmitRetry.StartTics:=0;
  1281.               i:=0;
  1282.               WHILE BufferType(RxBuf^)[i]<>0 DO
  1283.                 INC(i);
  1284.               SharedCap:=BufferType(RxBuf^)[i+1] AND (OURCAP or CANFREQ);
  1285.               IF (MaxReqFiles>0) THEN
  1286.               BEGIN
  1287.                 fn:=MakeReqFileName(Cfg.Addresses[Cfg.MainAdrNum].Net, Cfg.Addresses[Cfg.MainAdrNum].Node, GlobNodeStat);
  1288.                 MOVE(s[1],TxBuf^,Length(s));
  1289.                 New(ReqFile, Init(fn, SCreate, 128));
  1290.                 IF ReqFile<>NIL THEN
  1291.                 BEGIN
  1292.                   Move(RxBuf^,s[1],i);
  1293.                   s[0]:=Char(i);
  1294.                   ReqFile^.WriteLn(s);
  1295.                   Dispose(ReqFile, Done);
  1296.                 END;
  1297.                 SAddress:=Call;
  1298.                 Call:=OAddress;
  1299.                 IF InitReqFile(Cfg.Addresses[Cfg.MainAdrNum].Net,Cfg.Addresses[Cfg.MainAdrNum].Node) THEN
  1300.                 BEGIN
  1301.                   FillChar(TempSr,SizeOf(TempSr),0);
  1302.                   AddTpl(RspFile,'HEADER',ReqSr);
  1303.                   SendingReq:=GetReqName;
  1304.                   IF NOT SendingReq THEN GetFName(SendRSPFile);
  1305.                   IF TxFName<>'' THEN XState:=XSendFName ELSE XState:=XSendFReqNAK;
  1306.                 END;
  1307.                 Call:=SAddress;
  1308.               END
  1309.               ELSE XState:=XSendFReqNAK;
  1310.             END;
  1311.           END;
  1312.           FreqNAKPkt : BEGIN
  1313.             AttemptingReq:=FALSE;
  1314.             ReqStarted:=TRUE;
  1315.             SendPkt(NIL,0,FRNAKACKPKT);
  1316.           END;
  1317.           FrNAKACKPkt: BEGIN
  1318.             IF XState=XRcvFRNAKACK THEN
  1319.             BEGIN
  1320.               XmitRetry.StartTics:=0;
  1321.               GetFName(GoodXFer);
  1322.               XState:=XSendFName;
  1323.             END;
  1324.           END;
  1325.           EOFACKPKT: BEGIN
  1326.             IF (XState=XRcvEOFACK) OR (XState=XRcvFNACK) THEN
  1327.             BEGIN
  1328.               XmitRetry.StartTics:=0;
  1329.               IF XState=XRCVEOFACK THEN
  1330.               BEGIN
  1331.                 FileSent(TxFName,'J'+CrcStr(SharedCap AND CANCRC32=CANCRC32),FALSE);
  1332.                 DEC(TxLen,TxStPos);
  1333.                 Inc(TotalBytes,TxLen);
  1334.                 IF SendingReq THEN
  1335.                 BEGIN
  1336.                   Dec(TimeToNoMoreRequest, ReqSr.Size DIV (ComPort^.GetBaudRate DIV 10));
  1337.                   IF FreeArea=faNoWay THEN
  1338.                   BEGIN
  1339.                     Dec(MaxReqFiles); Dec(MaxReqBytes,ReqSr.Size) ;
  1340.                     Dec(MaxReqTime,ReqSr.Size DIV (ComPort^.GetBaudRate DIV 10));
  1341.                     WITH DRI DO
  1342.                     BEGIN
  1343.                       Inc(NumFiles); Inc(NumBytes, ReqSr.Size);
  1344.                       Inc(UsedTime, ReqSr.Size DIV (ComPort^.GetBaudRate DIV 10));
  1345.                     END;
  1346.                     MustWriteDRI:=True;
  1347.                   END;
  1348.                   INC(TempSr.Attr);
  1349.                   INC(TempSr.Size,ReqSr.Size);
  1350.                   AddTpl(RspFile,'FOUND',ReqSr);
  1351.                   SendingReq:=GetReqName;
  1352.                   IF NOT SendingReq THEN GetFName(GoodXFer);
  1353.                 END ELSE
  1354.                   GetFName(GoodXFer);
  1355.               END;
  1356.               IF (TxFName='') And (ExistFile(RspFile)) THEN
  1357.               BEGIN
  1358.                 GetFName(SendRspFile);
  1359.               END;
  1360.               XState:=XSendFName;
  1361.             END;
  1362.           END;
  1363.           RPOSPKT : BEGIN
  1364.             IF (XState=XSENDBlk) OR (XState=XRCVEOFACK) THEN
  1365.               IF LongInt(BufferType(RxBuf^)[4])<>LastRPosTime THEN
  1366.               BEGIN
  1367. {$IFDEF OS2}
  1368.                 LastRPosTime:=LongInt(Ptr({Seg(RxBuf^),}Ofs(RxBuf^)+4)^);
  1369. {$ELSE}
  1370.                 LastRPosTime:=LongInt(Ptr(Seg(RxBuf^),Ofs(RxBuf^)+4)^);
  1371. {$ENDIF}
  1372.                 XmitRetry.StartTics:=0;
  1373.                 ComPort^.PurgeOut;
  1374.                 TxPos:=LongInt(RxBuf^);
  1375.                 LastTx:=TxPos;
  1376.                 Seek(TxFile,TxPos);
  1377.                 IF IORESULT<>0 THEN
  1378.                 BEGIN
  1379.                   AddLog('!','Seek error: '+TxFname);
  1380.                   GOTO GiveUp;
  1381.                 END;
  1382.                 ShowError('Synchronizing '+Long2Str(TxPos),FALSE,FALSE,FALSE);
  1383.                 TxBlkLen:=TxBlkLen SHR 2;
  1384.                 IF TxBlkLen<64 THEN TxBlkLen:=64;
  1385.                 GoodBytes:=0;
  1386.                 INC(GoodNeeded,1024);
  1387.                 IF GoodNeeded>8192 THEN GoodNeeded:=8192;
  1388.                 XState:=XSENDBLK;
  1389.               END;
  1390.             END;
  1391.             HALTACKPKT : ;
  1392.             HALTPKT    : BEGIN
  1393. GiveUp:
  1394.               ShowError('Session aborted',TRUE,TRUE,FALSE);
  1395.               IF TxFName<>'' THEN GetFName(AbortXFer);
  1396.               IF RSTATE=RRCVBLK THEN Inc(TotalBytes,(RxPos-RxStPos));
  1397.               IF RxFName<>'' THEN RxClose(FailedXFer);
  1398.               GOTO abort;
  1399.             END;
  1400.           ELSE
  1401.           BEGIN
  1402.             ShowError('Unknown packet type',TRUE,TRUE,TRUE);
  1403.             GOTO GiveUp;
  1404.           END;
  1405.         END;
  1406.         PktType:=RcvPkt;
  1407.       END;
  1408. {$IFDEF JDebug}
  1409.       FastWrite('END Main loop XS='+Long2Str(XState)+' RS='+Long2Str(RState) ,1,1,7);
  1410. {$ENDIF}
  1411.     UNTIL (XState=0) And (RState=0);
  1412. BreakOut:
  1413.     Call:=OAddress;
  1414.     IF FSent=0 THEN
  1415.     BEGIN
  1416.       AddLog(':','Nothing to send to '+Address2Str(Call));
  1417.     END;
  1418. Abort:
  1419.     UnMarkNodeBusy(BusyFile);
  1420.     IF MustWriteDRI THEN WriteSuckerInfo(DRI);
  1421.     Call:=OAddress;
  1422.     TxDt1.t:=CurrentTime;
  1423.     TxDt1.d:=Today;
  1424.     Datetimediff(StartTime, TxDt1, Days, Secs);
  1425.     IF Secs = 0 THEN Secs := 1;
  1426.     Effektivitet := TotalBytes / Secs / ComPort^.GetBaudRate * 1000;
  1427.     AddLog('+','Session totals: CPS: '+Long2Str(TotalBytes DIV Secs)+' ('+Long2Str(Totalbytes)+' bytes)  Efficiency: '+
  1428.                Form('###.#',Effektivitet)+'%');
  1429.     EndBatch;
  1430.     FreeMem(TxBuf, 4096);
  1431.     FreeMem(RxBuf, 5000);
  1432.   END;
  1433.  
  1434. END.
  1435.